0

いくつかの TCard (カスタム コンポーネント) があり、再描画時にカードにテキストを描画します。同じコンポーネントが下部と上部で使用されます。しかし、一番下の TCard では、テキストを描画すると、テキストの白い背景が表示されます..上部の TCard はそうではありません..これがどこで行われているのか、またはその理由がわかりません。 ここに画像の説明を入力 どちらも同じ塗料を使用しています。

わかりました、一番下のカードを追加することから始めます。

/shows the form and sets up the cards.
procedure TFGame.FormShow(Sender: TObject);
var i: integer;
num : TValue;
db: widestring;
begin
  Maindir := label1.Caption;   //sets main dir
   db:= maindir;
   waitingforatarget := false;

  //Sets all oponents cards.
  OCardRed.background.loadfromfile(Maindir+'\pics\backcard.jpg');
  //..........


  //sets yoru cards
  Cardlava1.background.loadfromfile(Maindir+'\pics\backcard.jpg');
  Cardlava1.Repaint;
  //....

    getstartingcards;
  end;

カードを始める..

// gets all your starting cards and puts them into the corret rows.
procedure TFGame.GetStartingCards;
const
  ManaTypes : array [0..3] of string = ('Lava','Water','Dark','Nature');
var
   i: integer;
   z:integer;
   Cards: TObjectList<Tcard>;
begin
   // showmessage('list being created');
  Cards := TObjectList<TCard>.Create;
  z:=0;
  // add all tcards (Desgin ) to this list in order Lava,water,dark,nature
  cards.Add(cardLava1);
  cards.Add(cardlava2);
  cards.Add(cardlava3);
  cards.Add(cardlava4);
  cards.Add(cardwater1);
  cards.Add(cardwater2);
  cards.Add(cardwater3);
  cards.Add(cardwater4);
  cards.Add(carddark1);
  cards.Add(carddark2);
  cards.Add(carddark3);
  cards.Add(carddark4);
  cards.Add(cardnature1);
  cards.Add(cardnature2);
  cards.Add(cardnature3);
  cards.Add(cardnature4);
 //get data from DB
  for i := 0 to Length(ManaTypes) - 1 do
  begin
   // showmessage('getting manna types');
    with adoquery1 do
    begin
      close;
      sql.Clear;
      sql.Add('SELECT TOP 4 * FROM Cards WHERE Color = "'+ManaTypes[i]+'" ORDER BY Rnd(-(1000*ID)*Time())');
      open;
    end;

 //return the result of everything for giving mana type..
     if adoquery1.RecordCount = 0 then
        Showmessage('Error no cards in db');
     adoquery1.First;

     while not adoquery1.Eof do
     begin
        ///showmessage('writeing query to card '+inttostr(z));
        cards[z].Cname := adoquery1.FieldByName('Name').AsString;
        cards[z].Ccost := adoquery1.Fieldbyname('Cost').AsInteger;
        cards[z].Ctext := adoquery1.FieldByName('Text').AsString;
        cards[z].Ccolor := adoquery1.FieldByName('Color').AsString;
        cards[z].Cinplay := false; //in the play area
        if adoquery1.fieldbyname('Power').asstring <> '' then
            cards[z].Cpower := adoquery1.FieldByName('Power').AsInteger;
        if adoquery1.fieldbyname('Def').asstring <> '' then
            cards[z].Cdef := adoquery1.FieldByName('Def').AsInteger;
        if adoquery1.FieldByName('Type').AsString = 'Spell' then
           cards[z].Cspell := true
        else
           cards[z].Cspell := false;
        if adoquery1.FieldByName('Target').AsString = 'yes' then
            cards[z].SetTargetTrue
        else
            cards[z].settargetfalse;


        //based on color change background
        if cards[z].Ccolor = 'Lava' then
           cards[z].Background.loadfromfile(maindir+'\pics\lava.png');
        if cards[z].Ccolor = 'Water' then
           cards[z].Background.loadfromfile(maindir+'\pics\water.png');
        if cards[z].Ccolor = 'Dark' then
           cards[z].Background.loadfromfile(maindir+'\pics\dark.png');
        if cards[z].Ccolor = 'Nature' then
           cards[z].Background.loadfromfile(maindir+'\pics\nature.png');
       adoquery1.Next;
       cards[z].repaint;
       z:=z+1;
     end;
  end;
end;

それは、TCardの再描画が下のカードであることを示しています.

{TCard paint procedure}
//------------------------------------------------------------
procedure Tcard.Paint;
//------------------------------------------------------------
  begin
    Canvas.StretchDraw(ClientRect, FBackground.Graphic);
    if FBackground.Graphic = nil then
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.Pen.Style := psDash;
        Canvas.Rectangle(ClientRect);
      end ;
    if (FBackground.Graphic <> nil) and (ownercard = false) then
     begin
      if (CSpell = false) then
       begin
         SetLpower(inttostr(CPower));   //if monster card
         SetLDefence(inttostr(CDef));  //if monster card
       end;
      SetLCost(inttostr(CCost));
      setLText(CText);
     end;
  end;

数字へのすべての描画はこのようなものです..これは中央の数字用ですが、すべて同じことを行います

{Sets and draws the cost to the TCard}
//-------------------------------------------------------------
procedure TCard.SetLCost(value :string); //cost
//-------------------------------------------------------------
  begin
  if fbigcard = false then
    begin
     canvas.font.size := 8;
     Canvas.textout(19,1,inttostr(CCost));
    end
  else
    begin
     canvas.font.size := 12;
     canvas.font.color := TColor($FFFFFF);
     Canvas.textout(65,7,inttostr(CCost));
     canvas.Font.Color := CLBlack;
    end;
  end;

これですべてのコードだと思います..不足しているものが必要な場合はお知らせください ありがとうグレン

4

1 に答える 1

3

コンポーネントのPaint()メソッドで、テキストを描画する前に、 を設定Canvas.Brush.Style := bsClearするか直接呼び出しSetBkMode(Canvas.Handle, TRANSPARENT)ます。現在、背景グラフィックがない場合にのみ設定していBrush.Styleますが、背景グラフィックがある場合はすべてのテキストが描画されます。

ところで、それ自体をテストするGraphic <> nilだけでは、背景が指定されているかどうかを確認するのに十分ではありません。Graphic.Emptyまた、いつ確認する必要がありますGraphic <> nil。

代わりにこれを試してください：

procedure Tcard.Paint;
begin
  Canvas.Brush.Style := bsClear;

  if (FBackground.Graphic <> nil) and (not FBackground.Graphic.Empty) then
  begin
    Canvas.StretchDraw(ClientRect, FBackground.Graphic);
  end else
  begin
    Canvas.Pen.Style := psDash;
    Canvas.Rectangle(ClientRect);
  end;

  if (not ownercard) then
  begin
    if (not CSpell) then
    begin
      SetLpower(IntToStr(CPower));   //if monster card
      SetLDefence(IntToStr(CDef));  //if monster card
    end;
    SetLCost(IntToStr(CCost));
    SetLText(CText);
  end;
end;
于 2013-10-31T00:36:52.587 に答える