I'm having problems setting the page orientation of the output word document. I'm using the below code but it's coming up with an error, (unable to set page orientation to LANDSCAPE) if I comment out the page_orientation code (below) the word document is created, data is written to the document, everything works fine except obviously not in the LANDSCAPE orientation that is needed. Why isn't page_orientation working? Is there a work around?
PROCEDURE set_page_orientation( p_orientation IN VARCHAR2 )
Declare
PageSetup CLIENT_OLE2.OBJ_TYPE;
c_wdOrientPortrait CONSTANT NUMBER DEFAULT 0;
c_wdOrientLandscape CONSTANT NUMBER DEFAULT 1;
BEGIN
PageSetup := CLIENT_OLE2.GET_OBJ_PROPERTY( Selection, 'PageSetup' );
IF p_orientation = 'LANDSCAPE' THEN
CLIENT_OLE2.SET_PROPERTY( PageSetup, 'Orientation', c_wdOrientLandscape );
ELSE
CLIENT_OLE2.SET_PROPERTY( PageSetup, 'Orientation', c_wdOrientPortrait );
END IF;
END;
thanks in advance.
Unless I'm wrong,
1 is portrait (you set it to 0)
2 is landscape (you set it to 1)
Related
I have a TeeChart with 32 series and 6 custom axes. I need to print this chart, and we're using ReportBuilder everywhere else in our software to print charts (where there will be a printpreview on the screen first). We're using the CloneChart-method to have the Chart copied to ReportBuilder. With this chart we have the problem that the chart is not fully visible, like it is not stretching.
I also notice that the custom axes are not visible in ReportBuilder.
My goal is to have an exact copy of the TeeChart on the form, in ReportBuilder for printing purposes.
I tried copying the custom-axis, added the custom-axis in the ReportBuiled ppChart. Point is that the series are created at runtime. Hmmm, I need to link the series with the right custom axes or something.
I tried several other things in a search for streching, without success.
for i := 0 to aChartSource.SeriesCount - 1 do
begin
if aChartSource[i].Active then
begin
s := CloneChartSeries(aChartSource[i]);
s.ParentChart := AChartTarget.Chart;
s.GetVertAxis.Grid.Visible := (s.GetVertAxis.Grid.Visible and aShowGrid);
s.GetHorizAxis.Grid.Visible := (s.GetHorizAxis.Grid.Visible and aShowGrid);
s.Marks.Visible := (s.Marks.Visible and aShowMarks);
s.OnGetMarkText := GetMarkText;
for ii := 0 to AChartSource[i].Count -1 do
begin
if (s.ValueColor[ii] <> AChartSource[i].ValueColor[ii]) then
begin
s.ValueColor[ii] := AChartSource[i].ValueColor[ii];
vRedraw := TRUE;
end;
end;
end;
end;
{ Duplicate the axis }
for i := 0 to aChartSource.CustomAxes.Count - 1 do
begin
ppchrtKPI.Chart.CustomAxes.Add;
LAxis.
LAxis := ppchrtKPI.Chart.CustomAxes[ppchrtKPI.Chart.CustomAxes.Count-1];
LAxis.Assign(aChartSource.CustomAxes[i]);
end;
The ouput on the ReportBuilder's PrintPreview form is a chart with the series, but without the custom vertical axes. And the Teechart in ReportBuilder seems to be cropped; the series near the bottom X-axis are not visible
As said here, the problem with the custom axes sounds like the ticket #780 which was fixed in v2018.24.180321.
I want to know width and height of Image while it is in Clipboard, because if dimensions are too small then message like "Image is too small" should appear.
How to get width and height?
Unless you are prepared to manually parse the various image formats that you want to support, you can have the VCL simply load the image for you (just make sure suitable TGraphic classes have been registered, such as TGIFImage, TJPEGImage, TPNGImage, etc), and then you can ask the image for its dimensions, eg:
uses
Graphics, Clipbrd, Jpeg, PngImage, ...;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
p: TPicture;
begin
p := TPicture.Create;
try
try
p.Assign(Clipboard);
// use p.Graphic, p.Graphic.Width, p.Graphic.Height as needed...
except
// unable to access Clipboard, or Clipboard
// does not contain a supported image type
end;
finally
p.Free;
end;
end;
If this is about bitmap I think you may try this.
procedure TForm1.BitBtn1Click(Sender: TObject);
var b:TBitmap;
begin
if Clipboard.HasFormat(CF_BITMAP) then begin
b:=TBitmap.Create;
try
b.Assign(Clipboard);
ShowMessage(IntToStr(b.Width)+','+IntToStr(b.Height));
finally
b.Free;
end;
end;
end;
you can instead of showmessage put If-statement and do what ever you want.
I have a number of list view controls (TListView) that are used to display data. All these list view are set to "Detail" mode and all have TImageList assigned to their "SmallIcons" properties.
I'm trying to set the width of these column based on their contents exactly in the same way as if the user double-clicked on the separator slider at the end of each of the column headers.
First, I tried to set the column width to "-1" and "-2" for auto-sizing them: not only did that fail to work perfectly (some columns containing local characters - I'm using D6 and that means ANSI strings - are too low) but it also made the display of the column extremely slow (up to 30 seconds to display a list view with 6 column and 150 items when it's instantaneous with fixed width).
I have tried to use GetTextExtent on each cell to obtain the expected width of the text, adding some margin (from 2 to 10 pixels) and the expand the width of the column if it is lower than the calculated text width. Special treatment is applied to the first column (Items.caption) to take into account the display of the icon (I add the width of the icon, plus margin, to the width of the cell's text).
That didn't work either: in many cases (for instance, displaying the date in "yyyy/mm/dd hh:nn:ss" format results in a text too large to fit in the column).
Thinking that the issue could come from the window theme engine, I've switched to use GetThemeTextExtent instead of GetTextExtent but obtained the same result.
The only thing that seems to work is to add an arbitrary large margin (20 pixels) to each column width but, of course, that produces columns that are larger than they should be.
So, is there any alternative strategy ? I don't need anything but something that will calculate the correct width once: when the list is first populated. The code behind "clicking the column separator" works just fine but I can't find how to trigger it by code (well, I guess I could send the double click messages to the header directly as a hack)
For clarification, here are the things I tried the following code:
(in call case, there is a call made to ListView.canvas.Font.Assign(ListView.font). It is not in theses functions because a single assignment is enough but the code loops on all non-autosized columns of the listview).
Edit
My initial attempt using Windows Theme API:
function _GetTextWidth1(AText: widestring; IsHeader: boolean = false): Integer;
var
ATheme: HTheme;
rValue: TRect;
iPartID: integer;
AWidetext: WideString;
const
LVP_GROUPHEADER = 6;
begin
// try to get text width using theme API
ZeroMemory(#rValue, SizeOf(rValue));
ATheme := OpenThemeData(ListView.Handle, 'LISTVIEW');
try
if not IsHeader then
iPartID := LVP_LISTITEM
else
iPartID := LVP_GROUPHEADER;
AWidetext := AText;
GetThemeTextExtent( ATheme,
ListView.Canvas.Handle,
iPartID,
LIS_NORMAL,
PWideChar(AWidetext),
-1,
DT_LEFT or DT_SINGLELINE or DT_CALCRECT,
nil,
rValue
);
finally // wrap up
CloseThemeData(ATheme);
end; // try/finally
result := rValue.Right;
end;
next attempt using DrawText/DrawTextW:
function _GetTextWidth2(AText: widestring; IsHeader: boolean = false): Integer;
var
rValue: TRect;
lFlags: Integer;
begin
// try to get text width using DrawText/DrawTextW
rValue := Rect(0, 0, 0, 0);
lFlags := DT_CALCRECT or DT_EXPANDTABS or DT_NOPREFIX or DT_LEFT or DT_EXTERNALLEADING;
DrawText(ListView.canvas.Handle, PChar(AText), Length(AText), rValue, lFlags);
//DrawTextW(ListView.canvas.Handle, PWideChar(AText), Length(AText), rValue, lFlags);
result := rValue.Right;
end;
Third attempt using delphi's TextWidth function
function _GetTextWidth3(AText: widestring; IsHeader: boolean = false): Integer;
begin
// try to get text width using delphi wrapped around GetTextExtentPoint32
result := ListView.canvas.TextWidth(Atext);
end;
In all cases, I add a margin to the resulting width: I tried values as high as 20 pixels. I also take into account the possibility that the view use icons (in which case I add the width of the icon plus the margin again to the first column).
You could use canvas.TextWidth method. But be sure to use TListView canvas (not other, i.e. TForm) and first assign a font to canvas from TListView.
For example:
var
s: integer;
begin
ListView1.AddItem('test example item', nil);
ListView1.canvas.Font.Assign(ListView1.font);
s := ListView1.canvas.TextWidth(ListView1.Items[0].Caption) + 10; //this "+10" is a small additional margin
if s > ListView1.Columns[0].Width then
ListView1.Columns[0].Width := s;
It works fine for me.
I am a student, and I'm working on a little slots game (if the same random number comes up 3 timed, you win). I use Borland Pascal 7. I use graph to make this a bit more visual, but when I start the game my background turns from black to grey, and the other problem is that if I click the game start button, the game runs many times until I release the mouse button. How can I solve this?
Here is my full program:
program slots;
uses mymouse,graph,crt;
var gdriver,gmode,coin:integer;
m:mouserec;
a,b,c,coins:string;
procedure gomb(x1,y1,x2,y2:integer;szoveg:string);
var j,n:integer;
begin
setcolor(blue);
rectangle(x1,y1,x2,y2);
setfillstyle(1,blue);
floodfill(x1+2,y1+2,blue);
setcolor(0);
outtextxy((x1+x2)div 2 -textwidth(szoveg) div 2 ,(y1+y2) div 2-textheight(szoveg) div 2,szoveg);
end;
procedure randomal(var a,b,c:string);
begin
randomize;
STR(random(2)+1,a);
STR(random(2)+1,b);
STR(random(2)+1,c);
end;
procedure menu;
begin;
settextstyle(0,0,1);
outtextxy(20,10,'Meno menu');
gomb(20,20,90,50,'Teglalap');
gomb(20,60,90,90,'Inditas');
gomb(20,100,90,130,'Harmadik');
gomb(20,140,90,170,'Negyedik');
end;
procedure teglalap(x1,x2,y1,y2,tinta:integer);
begin
setcolor(tinta);
rectangle(x1,x2,y1,y2);
end;
procedure jatek(var a,b,c:string;var coin:integer;coins:string);
begin;
clrscr;
menu;
randomal(a,b,c);
if ((a=b) AND (b=c)) then coin:=coin+1 else coin:=coin-1;
settextstyle(0,0,3);
setbkcolor(black);
outtextxy(200,20,a);
outtextxy(240,20,b);
outtextxy(280,20,c);
STR(coin,coins);
outtextxy(400,400,coins);
end;
procedure eger;
begin;
mouseinit;
mouseon;
menu;
repeat
getmouse(m);
if (m.left) and (m.x>20) ANd (m.x<90) and (m.y>20) and (m.y<50) then teglalap(90,90,300,300,blue);
if (m.left) and (m.x>20) AND (m.x<90) and (m.y>60) and (m.y<90) then jatek(a,b,c,coin,coins);
until ((m.left) and (m.x>20) ANd (m.x<140) and (m.y>140) and (m.y<170));
end;
begin
coin:=50;
gdriver:=detect;
initgraph(gdriver, gmode, '');
eger;
end.
I have many years to use Turbo Pascal :)
I used this snippet to init BGI (graphic) mode:
Gd := Detect;
InitGraph(Gd, Gm, 'bgi');
if GraphResult <> grOk then
Halt(1);
SetBkColor(black);
Cleardevice;
If I recall correctly, ClearDevice is proper for clearing the screen, ClrScr is for text mode.
Now, GetMouse(m); probably returns immediately the mouse data thus the code
in the repeat loop runs again and again with no delay, even if you don't use the mouse.
One solution is to check if the mouse button is up before you execute that code or
add some kind of delay before calling the GetMouse.
So, here is the discussion I have just read:
http://www.mail-archive.com/delphi#delphi.org.nz/msg02315.html
BeginUpdate and EndUpdate is not thi procedures I need ...
Overriding API Call? I tried to get Update procedures code from ComCtrls unit, nut did not found...
Maybe you could post here a code to fix thi flicker of statusbar compoent if the only text changes in it? I mean - something like TextUpdate or some kind of TCanvas method or PanelsRepaint ... ?
The flickering is caused by this code:
Repeat
BlockRead(Fp, BuffArrayDebug[LineIndex], DataCapac, TestByteBuff); // DataCapac = SizeOf(DWORD)
ProgressBar1.StepIt;
if RAWFastMode.Checked then begin // checks for fast mode and modifyies progressbar
if BuffArrayDebug[LineIndex] = 0 then begin ProgressBar2.Max := FileSize(Fp) - DataCapac; ProgressBar2.Position := (LineIndex + 1) * DataCapac; LineDecr := True; end;
end else begin ProgressBar2.Max := FileSize(Fp); ProgressBar2.Position := LineIndex * DataCapac end;
if PreviewOpn.Caption = '<' then begin // starts data copying to preview area if expanded
Memo1.Lines.BeginUpdate;
if (LineIndex mod DataCapac) > 0 then HexMerge := HexMerge + ByteToHex(BuffArrayDebug[LineIndex]) else
begin
Memo1.Lines.Add(HexMerge); HexMerge := '';
end;
Memo1.Lines.EndUpdate;
end;
StatusBar1.Panels[0].Text := 'Line: ' + Format('%.7d',[LineIndex]) + ' | Data: ' + Format('%.3d',[BuffArrayDebug[LineIndex]]) + ' | Time: ' + TimeToStr(Time - TimeVarStart); StatusBar1.Update;
if FindCMDLineSwitch(ParamStr(1)) then begin
TrayIcon.BalloonTitle := 'Processing ' + ExtractFileName(RAWOpenDialog.FileName) + ' and reading ...';
TrayIcon.BalloonHint := 'Current Line: ' + inttostr(LineIndex) + #10#13 + ' Byte Data: ' + inttostr(TestByteBuff) + #10#13 + ' Hex Data: ' + ByteToHex(TestByteBuff);
TrayIcon.ShowBalloonHint;
end;
Inc(LineIndex);
Until EOF(Fp);
Any ideas?
There was comment with this link ( http://www.stevetrefethen.com/blog/UsingTheWSEXCOMPOSITEWindowStyleToEliminateFlickerOnWindowsXP.aspx ) and there is procedure that works ( no flickering whastsoever ), BUT IT IS VVVVVVVEEEEEERRRRRRYYYYYY SLOW!
1 type
2 TMyForm = class(TForm)
3 protected
4 procedure CreateParams(var Params: TCreateParams); override;
5 end;
6
7 ...
8
9 procedure TMyForm.CreateParams(var Params: TCreateParams);
10 begin
11 inherited;
12 // This only works on Windows XP and above
13 if CheckWin32Version(5, 1) then
14 Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED;
15 end;
16
Also - the target is not the form, but the StatusBar ... how to assign this method to statusbar?
The most important advise I can give you is to limit the number of status bar updates to maybe 10 or 20 per seconds. More will just cause unnecessary flicker, without any benefit for the user - they can't process the information that fast anyway.
OK, with that out of the way: If you want to use the WS_EX_COMPOSITED extended style for the status bar you have basically three options:
Create a descendent class that overrides the CreateParams() method and either install this into your IDE or (if you don't want to have it as its own component in the IDE) create the status bar at runtime.
Create a descendent class with the same name TStatusBar in another unit, override the CreateParams() method, and add this unit after ComCtrls to the form units using status bar controls. This will create an instance of your own TStatusBar class instead of the one in ComCtrls. See this answer for another example of the technique, hopefully its clear enough.
Use the vanilla TStatusBar class and set the WS_EX_COMPOSITED extended style at runtime.
I prefer the third option as the easiest one to experiment with, so here's the sample code:
procedure TForm1.FormCreate(Sender: TObject);
var
SBHandle: HWND;
begin
// This only works on Windows XP and above
if CheckWin32Version(5, 1) then begin
// NOTE: the following call will create all necessary window handles
SBHandle := StatusBar1.Handle;
SetWindowLong(SBHandle, GWL_EXSTYLE,
GetWindowLong(SBHandle, GWL_EXSTYLE) or WS_EX_COMPOSITED);
end;
end;
Edit:
If you want your code to properly support recent Windows versions and visual styles you should not even think of handling WM_ERASEBKGND yourself - the usual technique involves an empty handler for that method, and drawing the background in the WM_PAINT handler. This doesn't really work for standard controls like TStatusBar, as the background has to be drawn somewhere. If you just skip the background drawing in the WM_ERASEBKGND handler you will need to use owner-drawn panels spanning all of the status bar, otherwise the background simply won't be drawn, and the window underneath will shine through. Besides, the code for the owner-drawn panel would probably be very complex.
Again, a much better course of action would be to untangle the mess in your posted code, properly separate worker from display code, and reduce the update speed of your status bar texts to something reasonable. There just isn't any sense at all in going past the number of monitor updates per second, and even this is sensible only for games and similar visualizations.
You should check whether setting the TWinControl.DoubleBuffered property to True of the TStatusBar component will make it work. Also you can try enabling this property to the status bar's parent component (probably TForm). It's a blind shot - don't have access to the compiler from here. Another thought is to override the WM_ERASEBKGND message without calling inherited. First example found after using google: here.
----- Update after author's comment
I finally got access to the compiler and now it's working. We can use the WS_EX_COMPOSITED solution. All you need is is to create your own custom component basing on TCustomStatusBar or just create a class wrapper and create your status bar instance in runtime. Like this:
TMyStatusBar = class( TCustomStatusBar )
protected
{ Flickering work-around }
procedure CreateParams( var Params : TCreateParams ) ; override ;
end ;
TForm1 = class( TForm )
// (...)
private
FStatusBar : TMyStatusBar ;
// (...)
end ;
-------------
procedure TMyStatusBar.CreateParams( var Params : TCreateParams ) ;
begin
inherited ;
if CheckWin32Version( 5,1 ) then
Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED ;
end ;
-------------
{ Creating component in runtime }
procedure TForm1.FormCreate( Sender : TObject ) ;
begin
FStatusBar := TMyStatusBar.Create( Self ) ;
FStatusBar.Parent := Self ;
FStatusBar.Panels.Add ;
end ;
And it works for me. Good luck!